home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
ptv1n3.arc
/
CLONE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-08-01
|
2KB
|
54 lines
{ CLONE.PAS -- Clone Directories with TDRF, by Tom Swan }
{$M 2048, 0, 0} {- Small stack, no heap }
program clone;
uses dos;
const batchFile = 'C:\CLONE@@@.BAT';
var originalPath : pathStr;
bf : text; {- Batch file }
{---- Write TDRF commands to batch file bf }
procedure preparePath;
var plainPath : pathStr;
begin
plainPath := copy( fExpand( '.' ), 3, 255 );
if plainPath <> '\' then begin
writeln( bf, 'tdrf md ', plainPath );
writeln( bf, 'tdrf del ', plainPath, '\*.*' );
writeln( bf, 'tdrf t ', plainPath, '\*.* ', plainPath )
end { if }
end; { preparePath }
{---- Walk through all paths from current directory }
procedure readDirectory;
var sr : searchRec;
begin
preparePath;
findFirst( '*.*', directory, sr );
while dosError = 0 do begin
if ( sr.name[ 1 ] <> '.' ) and
( sr.attr and directory <> 0 ) then begin
chDir( sr.name ); {- Change to next level }
readDirectory; {- Process files there }
chDir( '..' ) {- Return to previous level }
end; { if }
findNext( sr )
end { while }
end; { readDirectory }
begin
getDir( 0, originalPath );
{$i-} chDir( paramStr( 1 ) ); {$i+}
if ioResult = 0 then begin
assign( bf, batchFile );
rewrite( bf ); {- Create new batch file }
readDirectory; {- Write commands to batch file }
close( bf ); {- Close batch file before running }
exec( getEnv( 'COMSPEC' ), '/C ' + batchFile );
erase( bf ); {- Erase the batch file }
chDir( originalPath )
end else begin
writeln( 'Clone Directories with TDRF, by Tom Swan' );
writeln( 'Syntax: CLONE [-?] [pathName]' )
end { else }
end.